home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / perl5 / perl5.002 / installperl < prev    next >
Encoding:
Text File  |  1996-01-29  |  10.9 KB  |  404 lines
  1. #!./perl
  2. BEGIN { @INC=('./lib', '../lib') }
  3. use File::Find;
  4. use File::Path qw(mkpath);
  5. use Config;
  6.  
  7. $mainperldir = "/usr/bin";
  8.  
  9. while (@ARGV) {
  10.     $nonono = 1 if $ARGV[0] eq '-n';
  11.     $versiononly = 1 if $ARGV[0] eq '-v';
  12.     shift;
  13. }
  14.  
  15. umask 022;
  16.  
  17. @scripts = qw(cppstdin
  18.         utils/c2ph utils/h2ph utils/h2xs utils/pstruct
  19.         utils/perlbug utils/perldoc
  20.         x2p/s2p x2p/find2perl
  21.         pod/pod2man pod/pod2html pod/pod2latex pod/pod2text);
  22.  
  23. # pod documentation now handled by separate installman script.
  24. # These two are archaic leftovers.
  25. @manpages = qw(x2p/a2p.man x2p/s2p.man);
  26.  
  27. @pods = (<pod/*.pod>);
  28.  
  29. $ver = $];
  30. $release = substr($ver,0,3);   # Not used presently.
  31. $patchlevel = substr($ver,3,2);
  32. die "Patchlevel of perl ($patchlevel)",
  33.     "and patchlevel of config.sh ($Config{'PATCHLEVEL'}) don't match\n"
  34.     if $patchlevel != $Config{'PATCHLEVEL'};
  35.  
  36. # Fetch some frequently-used items from %Config
  37. $installbin = $Config{installbin};
  38. $installscript = $Config{installscript};
  39. $installprivlib = $Config{installprivlib};
  40. $installarchlib = $Config{installarchlib};
  41. $installsitelib = $Config{installsitelib};
  42. $installsitearch = $Config{installsitearch};
  43. $installman1dir = $Config{installman1dir};
  44. $man1ext = $Config{man1ext};
  45. # Did we build libperl as a shared library?
  46. $d_shrplib = $Config{d_shrplib};
  47. $shrpdir = $Config{shrpdir};
  48. # Shared library and dynamic loading suffixes.
  49. $so = $Config{so};
  50. $dlext = $Config{dlext};
  51.  
  52. $d_dosuid = $Config{d_dosuid};
  53. $binexp = $Config{binexp};
  54. $osname = $Config{osname};
  55.  
  56. # Do some quick sanity checks.
  57.  
  58. if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
  59.  
  60.    $installbin        || die "No installbin directory in config.sh\n";
  61. -d $installbin        || mkpath($installbin, 1, 0777);
  62. -d $installbin        || die "$installbin is not a directory\n";
  63. -w $installbin        || die "$installbin is not writable by you\n"
  64.     unless $installbin =~ m#^/afs/# || $nonono;
  65.  
  66. -x 'perl'        || die "perl isn't executable!\n";
  67. -x 'suidperl'        || die "suidperl isn't executable!\n" if $d_dosuid;
  68.  
  69. -x 't/TEST'        || warn "WARNING: You've never run 'make test'!!!",
  70.     "  (Installing anyway.)\n";
  71.  
  72. if ($d_shrplib) {
  73.     if (!<libperl*.$so*>) {
  74.     warn "WARNING: Can't find libperl*.$so* to install into $shrpdir.",
  75.         "  (Installing other things anyway.)\n";
  76.     } else {
  77.     mkpath($shrpdir, 1, 0777);
  78.     -w $shrpdir    || $nonono || die "$shrpdir is not writable by you\n";
  79.     &cmd("cp libperl*.$so* $shrpdir");
  80.     }
  81. }
  82.  
  83. # First we install the version-numbered executables.
  84.  
  85. &safe_unlink("$installbin/perl$ver");
  86. &cmd("cp perl $installbin/perl$ver");
  87.  
  88. &safe_unlink("$installbin/sperl$ver");
  89. if ($d_dosuid) {
  90.     &cmd("cp suidperl $installbin/sperl$ver");
  91.     &chmod(04711, "$installbin/sperl$ver");
  92. }
  93.  
  94. exit 0 if $versiononly;
  95.  
  96. # Make links to ordinary names if installbin directory isn't current directory.
  97.  
  98. if (! &samepath($installbin, '.')) {
  99.     &safe_unlink("$installbin/perl", "$installbin/suidperl");
  100.     &link("$installbin/perl$ver", "$installbin/perl");
  101.     &link("$installbin/sperl$ver", "$installbin/suidperl") if $d_dosuid;
  102. }
  103.  
  104. if (! &samepath($installbin, 'x2p')) {
  105.     &safe_unlink("$installbin/a2p");
  106.     &cmd("cp x2p/a2p $installbin/a2p");
  107.     &chmod(0755, "$installbin/a2p");
  108. }
  109.  
  110. # Install scripts.
  111.  
  112. mkpath($installscript, 1, 0777);
  113.  
  114. for (@scripts) {
  115.     if (-f $_) {   # cppstdin might not exist on this system.
  116.     &cmd("cp $_ $installscript");
  117.     s#.*/##; &chmod(0755, "$installscript/$_");
  118.     }
  119. }
  120.  
  121. # Install pod pages.  Where? I guess in $installprivlib/pod.
  122. mkpath("${installprivlib}/pod", 1, 0777);
  123. foreach $file (@pods) {
  124.     # $file is a name like  pod/perl.pod
  125.     cp_if_diff($file, "${installprivlib}/${file}");
  126. }
  127.  
  128. # Install old man pages.
  129.  
  130. if ($installman1dir ne '') {
  131.     mkpath($installman1dir, 1, 0777);
  132.  
  133.     if (! &samepath($installman1dir, '.')) {
  134.     for (@manpages) {
  135.         ($new = $_) =~ s/man$/$man1ext/;
  136.         $new =~ s#.*/##;
  137.         print STDERR "  Installing $installman1dir/$new\n";
  138.         next if $nonono;
  139.         open(MI,$_) || warn "Can't open $_: $!\n";
  140.         open(MO,">$installman1dir/$new") || 
  141.             warn "Can't install $installman1dir/$new: $!\n";
  142.         print MO ".ds RP Release $release Patchlevel $patchlevel\n";
  143.         while (<MI>) {
  144.         print MO;
  145.         }
  146.         close MI;
  147.         close MO;
  148.     }
  149.     }
  150. }
  151.  
  152. # Install library files.
  153.  
  154. $do_installarchlib = $do_installprivlib = 0;
  155.     
  156. mkpath($installprivlib, 1, 0777);
  157. mkpath($installarchlib, 1, 0777);
  158. mkpath($installsitelib, 1, 0777) if ($installsitelib);
  159. mkpath($installsitearch, 1, 0777) if ($installsitearch);
  160.  
  161. if (chdir "lib") {
  162.     $do_installarchlib = ! &samepath($installarchlib, '.');
  163.     $do_installprivlib = ! &samepath($installprivlib, '.');
  164.  
  165.     if ($do_installarchlib || $do_installprivlib) {
  166.     find(\&installlib, '.');
  167.     }
  168.     chdir ".." || die "Can't cd back to source directory: $!\n";
  169. }
  170. else {
  171.     warn "Can't cd to lib to install lib files: $!\n";
  172. }
  173.  
  174. # Install header files and libraries.
  175. mkpath("$installarchlib/CORE", 1, 0777);
  176. foreach $file (<*.h libperl*.*>) {
  177.     cp_if_diff($file,"$installarchlib/CORE/$file");
  178. }
  179. # AIX needs perl.exp installed as well.
  180. cp_if_diff("perl.exp" ,"$installarchlib/CORE/perl.exp") if ($osname eq 'aix');
  181.  
  182. # If they have built sperl.o...
  183. cp_if_diff("sperl.o" ,"$installarchlib/CORE/sperl.o") if (-f 'sperl.o');
  184.  
  185.  
  186. # Offer to install perl in a "standard" location
  187.  
  188. $mainperl_is_instperl = 0;
  189.  
  190. if (-w $mainperldir && ! &samepath($mainperldir, $installbin) && !$nonono) {
  191.     # First make sure $mainperldir/perl is not already the same as
  192.     # the perl we just installed
  193.     if (-x "$mainperldir/perl") {
  194.     # Try to be clever about mainperl being a symbolic link
  195.     # to binexp/perl if binexp and installbin are different.
  196.     $mainperl_is_instperl =
  197.         &samepath("$mainperldir/perl", "$installbin/perl") ||
  198.          (($binexp ne $installbin) &&
  199.           (-l "$mainperldir/perl") &&
  200.           ((readlink "$mainperldir/perl") eq "$binexp/perl"));
  201.     }
  202.     if ((! $mainperl_is_instperl) &&
  203.     (&yn("Many scripts expect perl to be installed as " .
  204.          "$mainperldir/perl.\n" . 
  205.          "Do you wish to have $mainperldir/perl be the same as\n" .
  206.          "$binexp/perl? [y] ")))
  207.     {    
  208.     unlink("$mainperldir/perl");
  209.     eval 'link("$installbin/perl", "$mainperldir/perl")' ||
  210.     eval 'symlink("$binexp/perl", "$mainperldir/perl")' ||
  211.     &cmd("cp $installbin/perl $mainperldir");
  212.     $mainperl_is_instperl = 1;
  213.     }
  214. }
  215.  
  216. # Check to make sure there aren't other perls around in installer's
  217. # path.  This is probably UNIX-specific.  Check all absolute directories
  218. # in the path except for where public executables are supposed to live.
  219. # Also skip $mainperl if the user opted to have it be a link to the
  220. # installed perl.
  221.  
  222. @path = split(/:/, $ENV{"PATH"});
  223. @otherperls = ();
  224. for (@path) {
  225.     next unless m,^/,;
  226.     next if ($_ eq $binexp);
  227.     # Use &samepath here because some systems have other dirs linked
  228.     # to $mainperldir (like SunOS)
  229.     next if ($mainperl_is_instperl && &samepath($_, $mainperldir));
  230.     push(@otherperls, "$_/perl") if (-x "$_/perl" && ! -d "$_/perl");
  231. }
  232. if (@otherperls) {
  233.     print STDERR "\nWarning: perl appears in your path in the following " .
  234.     "locations beyond where\nwe just installed it:\n";
  235.     for (@otherperls) {
  236.     print STDERR "    ", $_, "\n";
  237.     }
  238.     print STDERR "\n";
  239. }
  240.  
  241. print STDERR "  Installation complete\n";
  242.  
  243. exit 0;
  244.  
  245. ###############################################################################
  246.  
  247. sub yn {
  248.     local($prompt) = @_;
  249.     local($answer);
  250.     local($default) = $prompt =~ m/\[([yn])\]\s*$/i;
  251.     print STDERR $prompt;
  252.     chop($answer = <STDIN>);
  253.     $answer = $default if $answer =~ m/^\s*$/;
  254.     ($answer =~ m/^[yY]/);
  255. }
  256.  
  257. sub unlink {
  258.     local(@names) = @_;
  259.  
  260.     foreach $name (@names) {
  261.     next unless -e $name;
  262.     print STDERR "  unlink $name\n";
  263.     unlink($name) || warn "Couldn't unlink $name: $!\n" unless $nonono;
  264.     }
  265. }
  266.  
  267. sub safe_unlink {
  268.     local(@names) = @_;
  269.  
  270.     foreach $name (@names) {
  271.     next unless -e $name;
  272.     print STDERR "  unlink $name\n";
  273.     next if $nonono;
  274.     next if unlink($name);
  275.     warn "Couldn't unlink $name: $!\n";
  276.     if ($! =~ /busy/i) {
  277.         print STDERR "  mv $name $name.old\n";
  278.         &rename($name, "$name.old") || warn "Couldn't rename $name: $!\n";
  279.     }
  280.     }
  281. }
  282.  
  283. sub cmd {
  284.     local($cmd) = @_;
  285.     print STDERR "  $cmd\n";
  286.     unless ($nonono) {
  287.     system $cmd;
  288.     warn "Command failed!!!\n" if $?;
  289.     }
  290. }
  291.  
  292. sub rename {
  293.     local($from,$to) = @_;
  294.     unless (unlink($to)) {
  295.     my($i);
  296.     for ($i = 1; $i < 50; $i++) {
  297.         last if rename($to, "$to.$i");
  298.     }
  299.     return 0 if $i >= 50;    # Give up!
  300.     }
  301.     link($from,$to) || return 0;
  302.     unlink($from);
  303. }
  304.  
  305. sub link {
  306.     local($from,$to) = @_;
  307.  
  308.     print STDERR "  ln $from $to\n";
  309.     link($from,$to) || warn "Couldn't link $from to $to: $!\n" unless $nonono;
  310. }
  311.  
  312. sub chmod {
  313.     local($mode,$name) = @_;
  314.  
  315.     printf STDERR "  chmod %o %s\n", $mode, $name;
  316.     chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name)
  317.     unless $nonono;
  318. }
  319.  
  320. sub samepath {
  321.     local($p1, $p2) = @_;
  322.     local($dev1, $ino1, $dev2, $ino2);
  323.  
  324.     if ($p1 ne $p2) {
  325.     ($dev1, $ino1) = stat($p1);
  326.     ($dev2, $ino2) = stat($p2);
  327.     ($dev1 == $dev2 && $ino1 == $ino2);
  328.     }
  329.     else {
  330.     1;
  331.     }
  332. }
  333.  
  334. sub installlib {
  335.     my $dir = $File::Find::dir;
  336.     $dir =~ s#^\.(?![^/])/?##;
  337.  
  338.     my $name = $_;
  339.     
  340.     # ignore patch backups and the .exists files.
  341.     return if $name =~ m{\.orig$|~$|^\.exists};
  342.  
  343.     $name = "$dir/$name" if $dir ne '';
  344.  
  345.     my $installlib = $installprivlib;
  346.     if ((substr($dir, 0, 4) eq 'auto') || ($name eq 'Config.pm')) {
  347.         $installlib = $installarchlib;
  348.     return unless $do_installarchlib;
  349.     } else {
  350.     return unless $do_installprivlib;
  351.     }
  352.  
  353.     if (-f $_) {
  354.     if (/\.al$/ || /\.ix$/) {
  355.         $installlib = $installprivlib;
  356.         #We're installing *.al and *.ix files into $installprivlib,
  357.         #but we have to delete old *.al and *.ix files from the 5.000
  358.         #distribution:
  359.         #This might not work because $archname might have changed.
  360.         &unlink("$installarchlib/$name");
  361.     }
  362.     system "cmp", "-s", $_, "$installlib/$name";
  363.     if ($?) {
  364.         &unlink("$installlib/$name");
  365.         mkpath("$installlib/$dir", 1, 0777);
  366.         cp_if_diff($_, "$installlib/$name");
  367.         # HP-UX (at least) needs to maintain execute permissions
  368.         # on dynamically-loaded libraries.
  369.         if ($name =~ /\.(so|$dlext)$/o) {
  370.         &chmod(0555, "$installlib/$name");
  371.         }
  372.         else {
  373.         &chmod(0444, "$installlib/$name");
  374.         }
  375.     }
  376.     } elsif (-d $_) {
  377.     mkpath("$installlib/$name", 1, 0777);
  378.     }
  379. }
  380.  
  381. # Copy $from to $to, only if $from is different than $to.
  382. # Also preserve modification times for .a libraries.
  383. # On some systems, if you do
  384. #   ranlib libperl.a
  385. #   cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a
  386. # and then try to link against the installed libperl.a, you might
  387. # get an error message to the effect that the symbol table is older
  388. # than the library.
  389. sub cp_if_diff {
  390.     my($from,$to)=@_;
  391.     -f $from || die "$0: $from not found";
  392.     system "cmp", "-s", $from, $to;
  393.     if ($?) {
  394.     my ($atime, $mtime);
  395.     unlink($to);   # In case we don't have write permissions.
  396.     cmd("cp $from $to");
  397.     # Restore timestamps if it's a .a library.
  398.     if ($to =~ /\.a$/) {
  399.         ($atime, $mtime) = (stat $from)[8,9];
  400.         utime $atime, $mtime, $to;
  401.     }
  402.     }
  403. }
  404.